home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbcaptur.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  6.3 KB  |  266 lines

  1. (*===========================================================================*)
  2. (* Capture control                                                           *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. UNIT BBCAPTUR;
  11.  
  12. INTERFACE
  13.  
  14. PROCEDURE capture_session(cmd_string : STRING);
  15. PROCEDURE capture_close;
  16. PROCEDURE capture_window (cmd_string : STRING);
  17.  
  18. IMPLEMENTATION
  19.  
  20. USES
  21.   DOS,
  22.   bbdummy,
  23.   bbmdata,
  24.   bbmess,
  25.   bbmisc5,
  26.   bbsdata,
  27.   bbstr,
  28.   bbwin;
  29.  
  30. CONST
  31.   window_names : STRING[24] = 'CONNECT MONITOR OPERATOR';
  32.  
  33. (*===========================================================================*)
  34. (* Capture a session                                                         *)
  35. (*===========================================================================*)
  36.  
  37. PROCEDURE capture_session(cmd_string : STRING);
  38.  
  39.   VAR
  40.     i          : INTEGER;
  41.     t_word     : STRING[10];
  42.     win_no     : BYTE;
  43.     word_count : BYTE;
  44.  
  45.   BEGIN;
  46.  
  47.     upcase_str_var(cmd_string);
  48.  
  49.     word_count := words(cmd_string);
  50.  
  51.     IF word_count = 1 THEN
  52.       BEGIN;
  53.  
  54.         IF capture_this_window = $FF THEN
  55.           BEGIN;
  56.             send_tnc_data_str('No capture session is active' + cr);
  57.             active_tcb^.error_sw := TRUE;
  58.             EXIT;
  59.           END;
  60.  
  61.         cmd_string := '============== Capture of '
  62.                       + subword(@window_names, capture_this_window, 1)
  63.                       + ' ended at ' + todays_date_time
  64.                       + ' ==============';
  65.  
  66.         capture_this_window := $FF;
  67.  
  68.         WRITELN(capture_file, cmd_string);
  69.  
  70.         send_tnc_data_str(cmd_string+ cr);
  71.  
  72.         CLOSE(capture_file);
  73.  
  74.         EXIT;
  75.  
  76.       END;
  77.  
  78.     IF word_count < 3 THEN
  79.       BEGIN;
  80.         send_message(message_not_en);
  81.         active_tcb^.error_sw := TRUE;
  82.         EXIT;
  83.       END;
  84.  
  85.     IF word_count > 3 THEN
  86.       BEGIN;
  87.         send_message(message_err_wrd);
  88.         active_tcb^.error_sw := TRUE;
  89.         EXIT;
  90.       END;
  91.  
  92.     t_word := subword(@cmd_string, 2, 1);
  93.  
  94.     win_no := find(@window_names, @t_word);
  95.  
  96.     IF win_no = 0 THEN
  97.       BEGIN;
  98.         send_tnc_data_str('Invalid window name' + cr);
  99.         active_tcb^.error_sw := TRUE;
  100.         EXIT;
  101.       END;
  102.  
  103.     cmd_string := subword(@cmd_string, 3, 1);
  104.  
  105.     ASSIGN(capture_file, cmd_string);
  106.  
  107.     {$I-}
  108.     APPEND(capture_file);
  109.     {$I+}
  110.     i := IORESULT;
  111.  
  112.     IF i = 2 THEN
  113.       BEGIN;
  114.         send_tnc_data_str('***** Opening new file for capture *****' + cr);
  115.         {$I-}
  116.         REWRITE(capture_file);
  117.         {$I+}
  118.         i := IORESULT;
  119.       END;
  120.  
  121.     IF i <> 0 THEN
  122.       BEGIN;
  123.         send_tnc_data_str(dos_err_message(i) + cr);
  124.         active_tcb^.error_sw := TRUE;
  125.         EXIT;
  126.       END;
  127.  
  128.     cmd_string := '============== Capture of '
  129.                   + subword(@window_names, win_no, 1)
  130.                   + ' started at ' + todays_date_time
  131.                   + ' ==============';
  132.  
  133.     send_tnc_data_str(cmd_string + cr);
  134.  
  135.     WRITELN(capture_file, cmd_string);
  136.  
  137.     capture_this_window := win_no;
  138.  
  139.   END;
  140.  
  141. (*===========================================================================*)
  142. (* Capture a window                                                          *)
  143. (*===========================================================================*)
  144.  
  145. PROCEDURE capture_window (cmd_string : STRING);
  146.  
  147.   VAR
  148.     i          : INTEGER;
  149.     out_count  : WORD;
  150.     t_word     : STRING[10];
  151.     win_file   : TEXT;
  152.     win_no     : BYTE;
  153.     word_count : BYTE;
  154.     work_ptr   : window_data_ptr;
  155.  
  156.   BEGIN;
  157.  
  158.     upcase_str_var(cmd_string);
  159.  
  160.     word_count := words(cmd_string);
  161.  
  162.     IF word_count < 3 THEN
  163.       BEGIN;
  164.         send_message(message_not_en);
  165.         active_tcb^.error_sw := TRUE;
  166.         EXIT;
  167.       END;
  168.  
  169.     IF word_count > 3 THEN
  170.       BEGIN;
  171.         send_message(message_err_wrd);
  172.         active_tcb^.error_sw := TRUE;
  173.         EXIT;
  174.       END;
  175.  
  176.     t_word := subword(@cmd_string, 2, 1);
  177.  
  178.     win_no := find(@window_names, @t_word);
  179.  
  180.     IF win_no = 0 THEN
  181.       BEGIN;
  182.         send_tnc_data_str('Invalid window name' + cr);
  183.         active_tcb^.error_sw := TRUE;
  184.         EXIT;
  185.       END;
  186.  
  187.     cmd_string := subword(@cmd_string, 3, 1);
  188.  
  189.     ASSIGN(win_file, cmd_string);
  190.  
  191.     {$I-}
  192.     APPEND(win_file);
  193.     {$I+}
  194.     i := IORESULT;
  195.  
  196.     IF i = 2 THEN
  197.       BEGIN;
  198.         send_tnc_data_str('***** Opening new file for window capture *****'
  199.                                                                           + cr);
  200.         {$I-}
  201.         REWRITE(win_file);
  202.         {$I+}
  203.         i := IORESULT;
  204.       END;
  205.  
  206.     IF i <> 0 THEN
  207.       BEGIN;
  208.         send_tnc_data_str(dos_err_message(i) + cr);
  209.         active_tcb^.error_sw := TRUE;
  210.         EXIT;
  211.       END;
  212.  
  213.     cmd_string := '============== Capture of '
  214.                   + subword(@window_names, win_no, 1)
  215.                   + ' done at ' + todays_date_time
  216.                   + ' ==============';
  217.  
  218.     send_tnc_data_str(cmd_string + cr);
  219.  
  220.     WRITELN(win_file, cmd_string);
  221.  
  222.     out_count := 0;
  223.  
  224.     WITH window_array[win_no] DO
  225.       BEGIN;
  226.         work_ptr := window_last;
  227.         IF work_ptr <> NIL THEN
  228.           BEGIN;
  229.             WHILE work_ptr^.last_line <> NIL DO
  230.               work_ptr := work_ptr^.last_line;
  231.           END;
  232.         WHILE work_ptr <> NIL DO
  233.           BEGIN;
  234.             INC(out_count);
  235.             WRITELN(win_file, work_ptr^.this_line);
  236.             work_ptr := work_ptr^.next_line;
  237.           END;
  238.       END;
  239.  
  240.     CLOSE(win_file);
  241.  
  242.     STR(out_count, t_word);
  243.  
  244.     send_tnc_data_str(t_word + ' data records written.' + cr);
  245.  
  246.   END;
  247.  
  248. (*===========================================================================*)
  249. (* Close captures                                                            *)
  250. (*===========================================================================*)
  251.  
  252. PROCEDURE capture_close;
  253.   VAR
  254.     t : STRING;
  255.  
  256.   BEGIN;
  257.  
  258.     t := 'GC';
  259.  
  260.     IF capture_this_window <> $FF THEN
  261.       capture_session(t);
  262.  
  263.   END;
  264.  
  265. END.
  266.